home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / scm / shell.e < prev    next >
Encoding:
Text File  |  1992-10-17  |  2.3 KB  |  90 lines
  1. ;; shell.e zilla 12dec various attempts at defining a shell facility
  2. ;; fsh, declare-shell, backquote, sh are the most useful.
  3. ;;
  4. ;; fsh calls format and executes the resulting string as a shell command-
  5. ;; (fsh "format-string" args) e.g. (fsh "ls ~a" dir)
  6. ;;
  7. ;; declare-shell declares a shell command which can be called sort of
  8. ;; like a scheme function-
  9. ;; (declare-shell ls mv cp)  ;; then
  10. ;;   (ls "/tmp")  (mv "/tmp/x" dir)
  11. ;;
  12. ;; (backquote "cmd") is analogous to the shell backquite facility.
  13. ;; It returns a list of string tokens representing the output of cmd.
  14. ;;
  15. ;; elk builtin (system) function uses /bin/sh
  16. ;; zelk adds builtin csh, cshf
  17. ;; (cshf) calls csh -f to avoid reading .cshrc 
  18. ;;
  19. ;; modified
  20. ;; 16jul    popen->pclose (was closing with close-input-port)
  21. ;;
  22.  
  23.  
  24. (require 'basics)
  25. (if (not (bound? 'chdir)) (load "chdir.o"))
  26. (if (not (bound? 'file-status)) (load "unix.o"))
  27. ;;system    ;;reference autoloads unix.o
  28. (provide 'shell.e)
  29.  
  30. (define $shellquitonerr #f)
  31. ;; caller can override this:
  32. (define shell-verbose? #t)
  33.  
  34.  
  35. ;; (fsh "formatstring" args) ==> (sh (format #f "formatstring" args))
  36. (define (fsh . args)
  37.   (cshf (apply format (cons #f args))))
  38.  
  39.  
  40. ;; 
  41. (define-macro (declare-shell . cmds)
  42.   ;(format #t "declare-shell: ~a~%" cmds)
  43.   (dolist (c cmds)
  44.     ;(print `(define (,c . args) (apply sh (cons ,(symbol->string c) args))))
  45.     (eval `(define (,c . args) (apply sh (cons ,(symbol->string c) args)))
  46.       (global-environment)
  47.     )
  48.   #f)
  49.   #t
  50. )
  51.  
  52.         
  53.  
  54. ;; get output of a shell command as a list of tokens 
  55. ;; (similar function to shell backquote feature)
  56. (define (backquote cmd)
  57.   (let* ((f (os-popen cmd "r"))
  58.      (token (read-string f))
  59.      (tokens nil))
  60.     (while (not (eof-object? token))
  61.       (set! tokens (cons token tokens))
  62.       (set! token (read-string f))
  63.     )
  64.     (os-pclose f)
  65.   (reverse tokens))
  66. )
  67.  
  68. (define getoutput backquote)
  69.  
  70.  
  71. ;; concatenate the strings, then call cshf
  72. (define (sh . cmd)
  73.   (if (and (= 1 (length cmd))  (list? (car cmd)))
  74.       (set! cmd (car cmd)))
  75.   (set! cmd                ;; insert spaces between
  76.     (map (lambda (x)
  77.            (string-append (if (number? x) (number->string x) x)
  78.                   " ")
  79.          )
  80.     cmd)
  81.   ) 
  82.   (let ((conc (apply string-append cmd)))
  83.     (if shell-verbose? (format #t "system: ~s~%" conc))
  84.     (let ((rc (cshf conc)))
  85.       (if (and $shellquitonerr (not (eqv? rc 0)))
  86.       (error 'system "non-zero return code ~a~%" rc))
  87.     rc)
  88.   )
  89. );sh
  90.